home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / edit / ae_14.zip / AE3.PAS < prev    next >
Pascal/Delphi Source File  |  1991-03-08  |  24KB  |  589 lines
  1. unit AE3 ;
  2.  
  3. {$B-}
  4. {$I-}
  5. {$S+}
  6. {$V-}
  7.  
  8. interface
  9.  
  10. uses Crt,Dos,AE0,AE1,AE2 ;
  11.  
  12. procedure EnterString (var S:string; Prompt:string ; MaxLength:byte ;
  13.                        CapsLock:boolean ; AlphaOnly:boolean) ;
  14. procedure EnterWord (var W:word ; Prompt:string ; MinValue,MaxValue:word) ;
  15. procedure EnterBoolean (var B:boolean ; Prompt:string ) ;
  16. procedure SaveFile (Wsnr:byte) ;
  17. function GetKeyNr : word ;
  18. function Answer (question:string) : boolean ;
  19. function Choose (Choices:string) : char ;
  20.  
  21. implementation
  22.  
  23. {-----------------------------------------------------------------------------}
  24. { Prompts the user to enter a string on the bottom line of the screen, with   }
  25. { maximum length <MaxLength>. Parameters CapsLock and AlphaOnly instruct the  }
  26. { procedure to convert lower case characters to upper case, and to accept     }
  27. { only alphanumeric characters, respectively. Pressing Escape will restore    }
  28. { the old value of S.                                                         }
  29. {-----------------------------------------------------------------------------}
  30.  
  31. procedure EnterString (var S:string; Prompt:string ; MaxLength:byte ;
  32.                        CapsLock:boolean ; AlphaOnly:boolean) ;
  33.  
  34. var OldS : string ;
  35.     OldXpos,OldYpos : byte ;
  36.     OldCursorType : byte ;
  37.     i : byte ;
  38.     Key : word ;
  39.     Start,VisibleLength : byte ;
  40.  
  41. begin
  42. { replace CR/LF pairs in string with CRLFalias }
  43. repeat i := Pos (CR+LF,S) ;
  44.        if i > 0
  45.           then begin
  46.                S[i] := CRLFalias[1] ;
  47.                S[i+1] := CRLFalias[2] ;
  48.                end ;
  49. until i = 0 ;
  50. OldXpos := WhereX ;
  51. OldYpos := WhereY ;
  52. OldCursorType := GetCursor ;
  53. SetCursor (Config.Setup.CursorType) ;
  54. OldS := S ;
  55. Start := 1 ;
  56. VisibleLength := ColsOnScreen - Length(Prompt) - 1 ;
  57. SetBottomLine (Prompt+Copy(S,Start,VisibleLength)) ;
  58. CursorTo (Length(Prompt)+1,25) ;
  59. Key := GetKeyNr ;
  60. if (Key < 256) or (Key = CtrlReturnKey)
  61.    then S := '' ;
  62. i := 1 ;
  63. repeat case Key of
  64.             264 {Bksp}    : if i > 1
  65.                                then begin
  66.                                     if Copy(S,i-1,2) = CRLFalias
  67.                                        then begin
  68.                                             Dec (i,2) ;
  69.                                             Delete (S,i,2) ;
  70.                                             end
  71.                                        else begin
  72.                                             Dec (i) ;
  73.                                             Delete (S,i,1) ;
  74.                                             end ;
  75.                                     end
  76.                                else WarningBeep ;
  77.             EscapeKey     : S := OldS ;
  78.             32..126       : if Length(S) < MaxLength
  79.                                then begin
  80.                                     if CapsLock
  81.                                        then Insert (UpCase(Chr(Key)),S,i)
  82.                                        else Insert (Chr(Key),S,i) ;
  83.                                     Inc (i) ;
  84.                                     end
  85.                                else WarningBeep ;
  86.             1..31,
  87.             127..255      : if (not AlphaOnly) and (Length(S) < MaxLength)
  88.                                then begin
  89.                                     Insert (Chr(Key),S,i) ;
  90.                                     Inc (i) ;
  91.                                     end
  92.                                else WarningBeep ;
  93.             CtrlReturnKey : if (not AlphaOnly) and (Length(S) < (MaxLength-1))
  94.                                then begin
  95.                                     Insert (CRLFalias,S,i) ;
  96.                                     Inc (i,2)
  97.                                     end
  98.                                else WarningBeep ;
  99.             327 {Home}    : i := 1 ;
  100.             335 {End}     : i := Length (S) + 1 ;
  101.             331 {Left}    : begin
  102.                             if i > 1
  103.                                then begin
  104.                                     if (Copy(S,i-2,2) = CRLFalias) and (i > 2)
  105.                                        then Dec (i,2)
  106.                                        else Dec (i) ;
  107.                                     end ;
  108.                             end ;
  109.             333 {Right}   : if i <= Length (S)
  110.                                then begin
  111.                                     if Copy(S,i,2) = CRLFalias
  112.                                        then Inc (i,2)
  113.                                        else Inc (i) ;
  114.                                     end ;
  115.             339 {Del}     : if Copy(S,i,2) = CRLFalias
  116.                                then Delete (S,i,2)
  117.                                else Delete (S,i,1) ;
  118.             end ; {of case}
  119.        if i > (Start+VisibleLength)
  120.           then Start := i - VisibleLength
  121.           else begin
  122.                if Start > i
  123.                   then Start := i ;
  124.                end ;
  125.        SetBottomLine (Prompt+Copy(S,Start,VisibleLength)) ;
  126.        CursorTo (Length(Prompt)+1+i-Start,25) ;
  127.        if (Key <> ReturnKey) and (Key <> EscapeKey) then Key := GetKeyNr ;
  128. until (Key = ReturnKey) or (Key = EscapeKey) ;
  129. { replace CRLFalias in string with CR/LF pairs }
  130. repeat i := Pos (CRLFalias,S) ;
  131.        if i > 0
  132.           then begin
  133.                S[i] := CR ;
  134.                S[i+1] := LF ;
  135.                end ;
  136. until i = 0 ;
  137. EscPressed := (Key = EscapeKey) ;
  138. SetBottomLine ('') ;
  139. CursorTo (OldXpos,OldYpos) ;
  140. SetCursor (OLdCursorType) ;
  141. end ;
  142.  
  143. {-----------------------------------------------------------------------------}
  144. { Prompts the user to enter a numeric value. If a string is entered that can  }
  145. { not be interpreted as a numeric value, or if the value is not within the    }
  146. { limits MinValue..MaxValue, a beep is given and the procedure is repeated.   }
  147. { Pressing Escape will restore the old value of W.                            }
  148. {-----------------------------------------------------------------------------}
  149.  
  150. procedure EnterWord (var W:word ; Prompt:string ; MinValue,MaxValue:word) ;
  151.  
  152. var S:string ;
  153.     Code : integer ;
  154.     OK : boolean ;
  155.  
  156. begin
  157. Str (W,S) ;
  158. repeat EnterString (S,Prompt,5,False,True) ;
  159.        Val (S,W,Code) ;
  160.        OK := (Code = 0) and (W >= MinValue) and (W <= MaxValue) ;
  161.        if not OK then WarningBeep ;
  162. until OK ;
  163. end ;
  164.  
  165. {-----------------------------------------------------------------------------}
  166. { Prompts the user to enter a boolean value. The current value is displayed,  }
  167. { and can be changed with the space bar or the cursor keys. Pressing Return   }
  168. { stores the value and exits, and the Y and N keys may be used for entering   }
  169. { the desired value directly. Pressing Escape will restore the old value.     }
  170. {-----------------------------------------------------------------------------}
  171.  
  172. procedure EnterBoolean (var B:boolean ; Prompt:string ) ;
  173.  
  174. var OldB : boolean ;
  175.     OldCursorType : byte ;
  176.     Key : word ;
  177.  
  178. begin
  179. OldCursorType := GetCursor ;
  180. SetCursor (Inactive) ;
  181. OldB := B ;
  182. repeat if B
  183.           then SetBottomLine (Prompt+' Yes')
  184.           else SetBottomLine (Prompt+' No') ;
  185.        Key := GetKeyNr ;
  186.        case Key of
  187.             32,328,331,333,336 : B := not B ;
  188.             78,110             : begin
  189.                                  B := False ;
  190.                                  Key := ReturnKey ;
  191.                                  end ;
  192.             89,121             : begin
  193.                                  B := True ;
  194.                                  Key := ReturnKey ;
  195.                                  end ;
  196.             EscapeKey          : B := OldB ;
  197.             ReturnKey          : ;
  198.             else                 WarningBeep ;
  199.             end ;
  200. until (Key = ReturnKey) or (Key = EscapeKey) ;
  201. EscPressed := (Key = EscapeKey) ;
  202. SetBottomLine ('') ;
  203. SetCursor (OldCursorType) ;
  204. end ;
  205.  
  206. {-----------------------------------------------------------------------------}
  207. { Saves the file in workspace <Wsnr> to disk. If there is no name yet,        }
  208. { the user is prompted for one.